home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #176 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #176 (1992)(Rhein-Sieg-Soft).adf / TUS-DATEI / TuS-Datei (.txt) < prev    next >
AmigaBASIC Source Code  |  1992-06-14  |  27KB  |  943 lines
  1. start:
  2. CLEAR,30000
  3. IF FRE(-1)<400000 THEN CLEAR ,170000,30000:DIM da$(102,50),l(102):fr=7
  4. IF FRE(-1)>400000 THEN CLEAR ,250000,30000:DIM da$(202,50),l(202):fr=10
  5. DIM pf$(50),merkefile$(50)
  6. OPEN "ram:tiuda" FOR APPEND AS 2
  7. IF LOF(2)<=0 THEN 
  8.  ta$=DATE$:ta$=MID$(ta$,4,2)+"."+LEFT$(ta$,2)+"."+RIGHT$(ta$,4):ort$="Immenstaad":drive$="df0:"
  9. ELSE
  10.  CLOSE#2:OPEN "ram:tiuda" FOR INPUT AS#2:INPUT#2,ort$:INPUT#2,ta$,drive$
  11. END IF
  12. CLOSE #2
  13. SCREEN 1,630,222,1,2:WINDOW 3,"  --  Leichtathletikdatenverwaltung V1.0   -- © by NEUDELSOFT",(0,0)-(620,200),0,1
  14. PALETTE 0,0,0,0:PALETTE 1,0.1,1,0.1:COLOR 1,0
  15. MENU 1,0,1,"Dateityp":MENU 1,1,1,"Einzeldisziplin":MENU 1,2,1,"Dreikampf":MENU 1,3,1,"Vierkampf":MENU 1,4,1,"Fünfkampf"
  16. MENU 2,0,1,"Arbeit":MENU 2,1,1,"Eingeben":MENU 2,2,1,"Suchen":MENU 2,3,1,"Sortieren"
  17. MENU 3,0,1,"Drucken":MENU 3,1,1,"Erste Leistungen":MENU 3,2,1,"Erste Wettkampfleistungen":MENU 3,3,1,"Listenbild"
  18. MENU 4,0,1,"System":MENU 4,1,1,"Laden":MENU 4,2,1,"Speichern":MENU 4,3,1,"Neue Datei eröffnen":MENU 4,4,1,"Preferences":MENU 4,5,1,"Ende":MENU 4,6,1,"About"
  19. REM MENU 4,7,1,"Punktlisten-Editor"
  20. MENU ON
  21. mn:
  22. tr=0
  23. a$=INKEY$:a$=INKEY$:m1=MENU(0):IF m1=0 THEN GOTO mn
  24. IF dt=0 THEN IF m1>1 AND m1<3 THEN mn
  25. ON m1 GOTO dateityp,arbeit,drucken,sys
  26. GOTO mn
  27. drucken:
  28. m2=MENU(1)
  29. ON m2 GOTO erstel,erstew,pliste
  30. GOTO mn
  31. pliste:
  32. CLS:PRINT "Name des Athleten:"
  33. LINE INPUT such$
  34. IF such$="" THEN CLS:GOTO mn
  35. such$=UCASE$(such$)
  36. PRINT :PRINT 
  37. PRINT "Filepool"
  38. pool=0
  39. poolwarte:
  40. pool=pool+1
  41. PRINT "Bitte geben Sie den Namen des "pool".Files an !"
  42. LINE INPUT pf$(pool)
  43. IF pf$(pool)="" AND pool>1 THEN pool=pool-1:GOTO pool2
  44. IF pf$(pool)="*" AND pool=1 THEN
  45.  FOR a=1 TO merkefile
  46.   pf$(a)=merkefile$(a)
  47.  NEXT a
  48.  pool=merkefile:GOTO pool2
  49. END IF
  50. IF pf$(pool)="" AND pool=1 THEN pool=0
  51. GOTO poolwarte
  52. pool2:
  53. FOR a=1 TO pool
  54.  merkefile$(a)=pf$(a)
  55. NEXT a
  56. merkefile=pool
  57. PRINT :PRINT "Bitte geben Sie das Jahr an !"
  58. LINE INPUT jahr$
  59. PRINT :PRINT "Bitte schalten Sie den Drucker ein !"
  60. SLEEP:SLEEP
  61. LPRINT " ";
  62. LPRINT CHR$(27)"[";6;"s";
  63. LPRINT CHR$(27)"[";72;"t";
  64. LPRINT CHR$(27)"[";7;"q";
  65. LPRINT CHR$(27)"[4m";
  66. LPRINT CHR$(27)"[1m";
  67. prenn=0
  68. PRINT :PRINT "Bitte legen Sie die Disk mit diesen Files ein !!!"
  69. SLEEP:SLEEP
  70. pkenn=1
  71. FOR pa=1 TO pool
  72.  GOSUB laden
  73.  found=0
  74.  FOR pb=1 TO d
  75.   IF UCASE$(LEFT$(da$(1,pb),LEN(such$)))=such$ THEN found=pb:pb=d
  76.  NEXT pb
  77.  IF found>0 THEN
  78.   IF prenn=0 THEN 
  79.    LPRINT:LPRINT
  80.    LPRINT "Alle Leistungen von "da$(1,found)" (*"da$(2,found)") im Jahre "jahr$
  81.    LPRINT CHR$(27)"[22m";:
  82.    LPRINT CHR$(27)"[24m";
  83.    LPRINT:LPRINT
  84.    prenn=1
  85.   END IF
  86.   LPRINT CHR$(27)"[4m";
  87.   LPRINT CHR$(27)"[3m";
  88.   IF dt=1 THEN 
  89.    LPRINT di$(1)
  90.   ELSEIF dt=3 THEN
  91.    LPRINT "Dreikampf (";
  92.   ELSEIF dt=4 THEN 
  93.    LPRINT "Vierkampf (";
  94.   ELSE 
  95.    LPRINT "Fünfkampf"
  96.    LPRINT "  (";
  97.   END IF
  98.   IF dt>1 THEN
  99.    FOR a=1 TO dt
  100.     LPRINT di$(a)" ";
  101.     IF a<dt THEN LPRINT",";
  102.    NEXT a
  103.    LPRINT " )"
  104.   END IF 
  105.   LPRINT CHR$(27)"[23m";
  106.   LPRINT CHR$(27)"[24m";
  107.   LPRINT:LPRINT
  108.   FOR pb=1 TO l(found)
  109.     tr=0
  110.     IF dt=1 THEN 
  111.      IF INSTR(1,da$(5*pb-2,found),":")=0 THEN
  112.       dr$=da$(5*pb-2,found)
  113.       drprp:
  114.       IF INSTR(1,dr$,".")>0 THEN
  115.        MID$(dr$,INSTR(1,dr$,"."),1)=","
  116.        GOTO drprp
  117.       END IF
  118.       IF INSTR(1,dr$,",")=0 THEN dr$=dr$+","
  119.       drpr2p:
  120.       IF LEN(dr$)<4 AND VAL(dr$)<10 THEN dr$=dr$+"0":GOTO drpr2p
  121.       IF LEN(dr$)<5 AND VAL(dr$)<100 AND VAL(dr$)>10 THEN dr$=dr$+"0":GOTO drpr2p
  122.       IF tr=2 AND LEN(dr$)<5 THEN dr$=dr$+"0":GOTO drpr2p
  123.       IF tr>0 THEN RETURN
  124.      ELSE  
  125.       b=LEN(STR$(VAL(da$(5*pb-2,found))))
  126.       dr$=RIGHT$(da$(5*pb-2,found),LEN(da$(5*pb-2,found))-b)
  127.       tr=2:GOSUB drprp
  128.       dr$=STR$(VAL(da$(5*pb-2,found)))+":"+dr$
  129.      END IF
  130.      druckl$=dr$+" "+e$(1)
  131.      druckl$=druckl$+" erzielt ":
  132.      IF UCASE$(da$(5*pb+(dt-2),found))="W" THEN
  133.       druckl$=druckl$+"im Wettkampf"
  134.      ELSEIF UCASE$(da$(5*pb+(dt-2),found))="R" THEN
  135.       druckl$=druckl$+"bei Rückenwind"
  136.      ELSEIF UCASE$(da$(5*pb+(dt-2),found))="S" THEN
  137.       druckl$=druckl$+"in der Staffel"
  138.      ELSE  
  139.       druckl$=druckl$+"im Training"
  140.      END IF
  141.      druckl$=druckl$+" am "+da$(5*pb+dt,found)+" in "+da$(5*pb+dt-1,found)
  142.      drucka$="Sportabzeichen :"
  143.      IF UCASE$(da$(5*pb+dt+1,found))="J" THEN 
  144.       drucka$=drucka$+" ja"
  145.      ELSE
  146.       drucka$=drucka$+" nein"
  147.      END IF
  148.      LPRINT druckl$
  149.      LPRINT drucka$
  150.      LPRINT
  151.     END IF      
  152.     IF dt>1 THEN
  153.      druckl$=da$(5*pb+(dt-2)+((dt-1)*(pb-1)),found)+" Punkte"
  154.      druckl$=druckl$+" ("
  155.      FOR b=1 TO dt
  156.       IF INSTR(1,da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found),":")=0 THEN
  157.        tr=1:dr$=da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found):GOSUB drprp
  158.       ELSE                                        
  159.        c=LEN(STR$(VAL(da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found))))
  160.        dr$=RIGHT$(da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found),LEN(da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found))-c)
  161.        tr=2:GOSUB drprp
  162.        dr$=STR$(VAL(da$(5*pb-3+b+((dt-1)*(pb-1)),found)))+":"+dr$
  163.       END IF
  164.       druckl$=druckl$+" "+dr$+" "+e$(b)
  165.       IF b<dt THEN druckl$=druckl$+","
  166.      NEXT b
  167.      druckl$=druckl$+" )"
  168.      druckk$="erzielt am "+da$(5*pb+dt+((dt-1)*(pb-1)),found)+" in "+da$(5*pb+dt-1+((dt-1)*(pb-1)),found)
  169.      drucka$="Abzeichen :"
  170.      IF UCASE$(da$(5*pb+dt+1+((dt-1)*(pb-1)),found))="G" THEN
  171.       drucka$=drucka$+" Gold"
  172.      ELSEIF UCASE$(da$(5*pb+dt+1+((dt-1)*(pb-1)),found))="S" THEN
  173.       drucka$=drucka$+" Silber"
  174.      ELSEIF UCASE$(da$(5*pb+dt+1+((dt-1)*(pb-1)),found))="B" THEN
  175.       drucka$=drucka$+" Bronze"
  176.      ELSE
  177.       drucka$=drucka$+" keins" 
  178.      END IF
  179.      LPRINT druckl$
  180.      LPRINT druckk$
  181.      LPRINT drucka$
  182.      LPRINT
  183.     END IF
  184.    NEXT pb
  185.    LPRINT
  186.   END IF
  187.  NEXT pa 
  188.  pkenn=0:prenn=0
  189. LPRINT CHR$(12) 
  190. CLS:GOTO mn  
  191. abfrage:
  192. CLS:PRINT "Welche Bezeichnung (Altersklasse) ?"
  193. LINE INPUT a$
  194. RETURN
  195. erstew:
  196. IF d=0 THEN mn
  197. GOSUB abfrage
  198. b$="Bestleistungen"
  199. GOSUB pref
  200. platz=0
  201. FOR a=1 TO d
  202. FOR x=1 TO l(a)
  203. IF dt>1 OR UCASE$(da$(5*x+(dt-2),a))="W" THEN
  204.  warn=1:wurm=x:platz=platz+1:GOSUB drpf
  205.  x=l(a)
  206. END IF 
  207. NEXT x
  208. warn=0
  209. NEXT a
  210. LPRINT CHR$(12) 
  211. CLS
  212. GOTO mn
  213. pref:
  214. CLS:PRINT "Bitte Drucker einschalten !!"
  215. SLEEP:SLEEP
  216. LPRINT " ";
  217. LPRINT CHR$(27)"[";6;"s";
  218. LPRINT CHR$(27)"["71"t";
  219. LPRINT CHR$(27)"["5"q";
  220. LPRINT 
  221. LPRINT CHR$(27)"[6w";
  222. LPRINT b$" "a$
  223. LPRINT CHR$(27)"[5w";
  224. LPRINT:LPRINT CHR$(27)"[4m";
  225. LPRINT CHR$(27)"[1m";
  226. IF dt=1 THEN 
  227.  LPRINT di$(1)
  228. ELSEIF dt=3 THEN
  229.  LPRINT "Dreikampf (";
  230. ELSEIF dt=4 THEN 
  231.  LPRINT "Vierkampf (";
  232. ELSE 
  233.  LPRINT "Fünfkampf (";
  234. END IF
  235. IF dt>1 THEN
  236.  FOR a=1 TO dt
  237.   LPRINT " "di$(a)" ";
  238.   IF a<dt THEN LPRINT",";
  239.  NEXT a
  240.  LPRINT " )"
  241. END IF 
  242. LPRINT CHR$(27)"[22m";:LPRINT CHR$(27)"[24m";:LPRINT
  243. RETURN
  244. erstel:
  245. IF d=0 THEN mn
  246. GOSUB abfrage
  247. b$="Erste Leistungen"
  248. GOSUB pref
  249. platz=0
  250. FOR a=1 TO d
  251. wurm=1:platz=platz+1
  252. drpf:
  253.  druckn$=da$(1,a)
  254.  druckb$=da$(2,a)
  255.  IF dt=1 THEN 
  256.   IF INSTR(1,da$(5*wurm-2,a),":")=0 THEN
  257.    dr$=da$(5*wurm-2,a)
  258.    drpr:
  259.    IF INSTR(1,dr$,".")>0 THEN
  260.     MID$(dr$,INSTR(1,dr$,"."),1)=","
  261.     GOTO drpr
  262.    END IF
  263.    IF INSTR(1,dr$,",")=0 THEN dr$=dr$+","
  264.    drpr2:
  265.    IF LEN(dr$)<4 AND VAL(dr$)<10 THEN dr$=dr$+"0":GOTO drpr2
  266.    IF LEN(dr$)<5 AND VAL(dr$)<100 AND VAL(dr$)>=10 THEN dr$=dr$+"0":GOTO drpr2
  267.    IF tr=2 AND LEN(dr$)<5 THEN dr$=dr$+"0":GOTO drpr2
  268.    IF tr>0 THEN RETURN
  269.   ELSE
  270.    b=LEN(STR$(VAL(da$(5*wurm-2,a))))
  271.    dr$=RIGHT$(da$(5*wurm-2,a),LEN(da$(5*wurm-2,a))-b)
  272.    tr=2:GOSUB drpr 
  273.    dr$=STR$(VAL(da$(5*wurm-2,a)))+":"+dr$
  274.   END IF
  275.   druckl$=dr$+" "+e$(1)
  276.   druckk$="erzielt ":
  277.   IF UCASE$(da$(5*wurm+(dt-2),a))="W" THEN
  278.    druckk$=druckk$+"im Wettkampf"
  279.   ELSEIF UCASE$(da$(5*wurm+(dt-2),a))="R" THEN
  280.    druckk$=druckk$+"bei Rückenwind"
  281.   ELSE  
  282.    druckk$=druckk$+"im Training"
  283.   END IF
  284.   druckk$=druckk$+" am "+da$(5*wurm+dt,a)+" in "+da$(5*wurm+dt-1,a)
  285.   drucka$="Sportabzeichen :"
  286.   IF UCASE$(da$(5*wurm+dt+1,a))="J" THEN 
  287.    drucka$=drucka$+" ja"
  288.   ELSE
  289.    drucka$=drucka$+" nein"
  290.   END IF
  291.  END IF      
  292.  IF dt>1 THEN
  293.   druckl$=da$(5+(dt-2),a)+" Punkte"
  294.   druckzl$="   ("
  295.   FOR b=1 TO dt
  296.    IF INSTR(1,da$(5+(-3+b),a),":")=0 THEN
  297.     tr=1:dr$=da$(5+(-3+b),a):GOSUB drpr
  298.    ELSE
  299.     c=LEN(STR$(VAL(da$(5+(-3+b),a))))
  300.     dr$=RIGHT$(da$(5-3+b,a),LEN(da$(5-3+b,a))-c)
  301.     tr=1:GOSUB drpr
  302.     dr$=STR$(VAL(da$(5-3+b,a)))+":"+dr$
  303.    END IF
  304.    druckzl$=druckzl$+" "+dr$+" "+e$(b)
  305.    IF b<dt THEN druckzl$=druckzl$+","
  306.   NEXT b
  307.   druckzl$=druckzl$+" )"
  308.   druckk$="erzielt am "+da$(5+dt,a)+" in "+da$(5+dt-1,a)
  309.   drucka$="Abzeichen :"
  310.   IF UCASE$(da$(5+dt+1,a))="G" THEN
  311.    drucka$=drucka$+" Gold"
  312.   ELSEIF UCASE$(da$(5+dt+1,a))="S" THEN
  313.    drucka$=drucka$+" Silber"
  314.   ELSEIF UCASE$(da$(5+dt+1,a))="B" THEN
  315.    drucka$=drucka$+" Bronze"
  316.   ELSE
  317.    drucka$=drucka$+" keins" 
  318.   END IF
  319.  END IF
  320.  GOSUB druck
  321.  IF warn=1 THEN RETURN
  322. NEXT a 
  323. LPRINT CHR$(12)
  324. CLS
  325. GOTO mn
  326. druck:
  327. LPRINT USING"##";platz;
  328. LPRINT".";
  329. LPRINT CHR$(27)"[3m";
  330. LPRINT druckn$;
  331. LPRINT CHR$(27)"[23m";
  332. LPRINT " ( "druckb$" ) : "druckl$
  333. IF dt>1 THEN LPRINT druckzl$
  334. LPRINT "   "druckk$
  335. LPRINT "   "drucka$
  336. LPRINT
  337. RETURN
  338. sys:
  339. m2=MENU (1):IF m2=0 THEN mn
  340. ON m2 GOTO laden,speichern,neuedaten,datum,schluss,about,pedi
  341. GOTO mn
  342. pedi:
  343. CLS:PRINT "Wollen Sie wirklich den Editor laden (j/n) ?"
  344. a$="":WHILE a$="":a$=INKEY$:WEND
  345. IF UCASE$(a$)<>"J" THEN mn
  346. WINDOW CLOSE 3:SCREEN CLOSE 1:LOAD "Peditor",r
  347. about:
  348. LOCATE 3,10:PRINT "Dieses Programm ist eine NEUDELSOFT-Produktion, die speziell
  349. LOCATE 5,9:PRINT "für den TUS Immenstaad auf einem Amiga 2000 geschrieben wurde."
  350. LOCATE 7,20:PRINT "Programmed by A.Neumann ©1988 by Neudelsoft"
  351. LOCATE 9,1:PRINT "Special Greetings to:Danny,Karsten,Marko,Alex,J+J Himpel,Robert,Hartmann,Pit,..."
  352. SLEEP:SLEEP:CLS:GOTO mn 
  353. datum:
  354. LOCATE 2,10:PRINT "Preferences Version 1.00"
  355. LOCATE 5,5:PRINT "Datum............:";ta$
  356. LOCATE 8,5:PRINT "Ort..............:";ort$
  357. LOCATE 11,5:PRINT "Laufwerk.........:";drive$
  358. LOCATE 17,5:PRINT "Ende.............................Ende"
  359. prefwarte:
  360. Test=MOUSE(0)
  361. WHILE MOUSE(0)=0:WEND
  362. y=MOUSE(2)
  363. po=1
  364. IF y>27 AND y<45 THEN
  365.  prefwarte1:
  366.  tx=21*8+po*8:
  367.  LINE (tx,41)-(tx+8,41),1
  368.  a$=INKEY$:WHILE a$="":a$=INKEY$:WEND
  369.  IF a$=CHR$(8) AND po>1 THEN 
  370.   LINE (tx,41)-(tx+8,41),0
  371.   po=po-1:IF MID$(ta$,po,1)="." THEN po=po-1
  372.  END IF
  373.  IF a$=CHR$(13) THEN LINE (tx,41)-(tx+8,41),0:po=0:GOTO prefwarte
  374.  IF a$=" " AND po<10 THEN
  375.   LINE (tx,41)-(tx+8,41),0:po=po+1
  376.   IF MID$(ta$,po,1)="." THEN po=po+1
  377.  END IF
  378.  IF VAL(a$)=0 AND a$<>"0" THEN prefwarte1
  379.  LOCATE 5,po+22:PRINT a$;
  380.  MID$(ta$,po,1)=a$
  381.  LINE (tx,41)-(tx+8,41),0:IF po<10 THEN po=po+1
  382.  IF MID$(ta$,po,1)="." THEN po=po+1
  383.  GOTO prefwarte1
  384. ELSEIF y>51 AND y<69 THEN
  385.  LOCATE 8,23:PRINT SPACE$(80);:LOCATE 8,23:LINE INPUT a$
  386.  IF a$<>"" THEN ort$=a$
  387.  LOCATE 8,23:PRINT ort$
  388. ELSEIF y>75 AND y<93 THEN
  389.  LOCATE 11,23:PRINT SPACE$(80);:LOCATE 11,23:LINE INPUT a$
  390.  IF a$<>"" THEN drive$=a$
  391.  LOCATE 11,23:PRINT drive$
  392. ELSEIF y>123 AND y<141 THEN
  393.  dasa:
  394.  CLS
  395.  OPEN "ram:tiuda" FOR OUTPUT AS #2
  396.  PRINT#2,ort$
  397.  PRINT#2,ta$
  398.  PRINT#2,drive$
  399.  CLOSE #2
  400.  GOTO mn
  401. END IF
  402. GOTO prefwarte
  403. schluss:
  404. LOCATE 1,1:PRINT "Wollen Sie das Programm beenden ?"
  405. a$=""
  406. WHILE a$><"j" AND a$<>"n"
  407.  a$=INKEY$
  408. WEND
  409. IF a$="n" THEN CLS:GOTO mn
  410. KILL "ram:tiuda"
  411. MENU RESET:WINDOW CLOSE 3:SCREEN CLOSE 1:SYSTEM
  412. neuedaten:
  413. LOCATE 1,1:PRINT "Wollen Sie wirklich das Programm neu starten [die Daten sind gespeichert ?]"
  414. a$=""
  415. WHILE a$<>"j" AND a$<>"n"
  416.  a$=INKEY$
  417. WEND
  418. IF a$="n"THEN CLS:GOTO mn
  419. RUN
  420. speichern:IF d=0 THEN GOTO mn
  421. LOCATE 1,1:PRINT "Wollen Sie wirklich speichern ? [J/N] "
  422. a$=""
  423. WHILE a$<>"j" AND a$<>"n"
  424.  a$=INKEY$
  425. WEND
  426. IF a$="n" THEN CLS:GOTO mn
  427. IF oldfile$<>"" THEN
  428.  PRINT :PRINT "Bleiben Sie beim Filenamen `"oldfile$"` ? (J/N)"
  429.  a$=""
  430.  WHILE a$<>"j" AND a$<>"n"
  431.   a$=INKEY$
  432.  WEND
  433.  IF a$="j" THEN fin$=oldfile$:GOTO readysaven
  434. END IF 
  435. PRINT :LINE INPUT "Filename:";fin$
  436. oldfile$=fin$
  437. readysaven:
  438. PRINT :PRINT "Legen Sie bitte die Datendisk in Drive "drive$" und warten Sie bis die LED aus ist."
  439. SLEEP:SLEEP
  440. OPEN drive$+fin$ FOR OUTPUT AS #2
  441. PRINT #2,dt
  442. FOR a=1 TO dt:PRINT#2,di$(a):PRINT #2,e$(a):NEXT a
  443. IF dt>1 THEN
  444.  FOR a=1 TO dt
  445.   WRITE#2,punktfile$(a)
  446.  NEXT a
  447. END IF
  448. PRINT #2,d                    
  449. FOR a=1 TO d:
  450. WRITE#2,da$(1,a):WRITE#2,da$(2,a)
  451. PRINT #2,l(a)
  452. FOR c=1 TO l(a)
  453. FOR b=1 TO dt:WRITE#2,da$(5*c+(-3+b)+((dt-1)*(c-1)),a)
  454. NEXT b
  455. WRITE#2,da$(5*c+(dt-2)+((dt-1)*(c-1)),a)
  456. WRITE#2,da$(5*c+(dt-1)+((dt-1)*(c-1)),a)
  457. WRITE#2,da$(5*c+dt+((dt-1)*(c-1)),a)
  458. WRITE#2,da$(5*c+dt+1+((dt-1)*(c-1)),a)
  459. NEXT c:NEXT a:CLOSE #2:CLS
  460. GOTO mn
  461. laden:
  462. IF pkenn=1 THEN la2
  463. LOCATE 1,1:PRINT "Wollen Sie wirklich laden ? [J/N] "
  464. a$=""
  465. WHILE a$><"j" AND a$<>"n"
  466.  a$=INKEY$
  467. WEND
  468. IF a$="n" THEN CLS:GOTO mn
  469. IF oldfile$<>"" THEN
  470.  PRINT :PRINT "Bleiben Sie beim Filenamen `"oldfile$"` ?(J/N)"
  471.  a$=""
  472.  WHILE a$<>"j" AND a$<>"n"
  473.   a$=INKEY$
  474.  WEND
  475.  IF a$="j" THEN fin$=oldfile$:GOTO readyladen
  476. END IF
  477. PRINT :LINE INPUT "Filename:";fin$
  478. oldfile$=fin$
  479. readyladen:
  480. PRINT :PRINT "Legen Sie bitte die Datendisk in Drive "drive$" und warten Sie, bis die LED aus ist."
  481. SLEEP:SLEEP
  482. la2:
  483. IF pkenn=1 THEN fin$=pf$(pa)
  484. IF d=0 THEN d=1
  485. FOR a=1 TO d
  486.  l(a)=0
  487. NEXT a
  488. OPEN drive$+fin$ FOR INPUT AS #2
  489. INPUT #2,dt
  490. FOR a=1 TO dt:INPUT #2,di$(a):INPUT #2,e$(a):NEXT a
  491. IF dt>1 THEN
  492.  FOR a=1 TO dt
  493.   INPUT#2,punktfile$(a)
  494.  NEXT a
  495. END IF
  496. INPUT #2,d
  497. FOR a=1 TO d
  498. INPUT #2,da$(1,a):INPUT #2,da$(2,a)
  499. INPUT #2,l(a)                                        
  500. FOR c=1 TO l(a)
  501. FOR b=1 TO dt:INPUT #2,da$(5*c+(-3+b)+((dt-1)*(c-1)),a)
  502. NEXT b
  503. INPUT #2,da$(5*c+(dt-2)+((dt-1)*(c-1)),a)
  504. INPUT #2,da$(5*c+(dt-1)+((dt-1)*(c-1)),a)
  505. INPUT #2,da$(5*c+dt+((dt-1)*(c-1)),a)
  506. INPUT #2,da$(5*c+dt+1+((dt-1)*(c-1)),a)
  507. NEXT c:NEXT a:CLOSE #2:CLS:FOR a=1 TO 4:MENU 1,a,0:NEXT a
  508. IF pkenn=1 THEN RETURN
  509. GOTO mn
  510. dateityp:
  511. m2=MENU(1):fo=0
  512. WINDOW 4," - Dateityp -",(0,0)-(500,200),0,1
  513. IF m2>1 THEN m2=m2+1
  514. dt=m2
  515. FOR a=1 TO m2
  516.  PRINT a".Diziplin,Einheit [q,q] für Ende"
  517.  INPUT di$(a),e$(a):IF di$(a)="q" AND e$(a)="q" THEN fo=1:a=m2
  518.  REM IF dt>1 THEN 
  519.  REM  PRINT "In welchem File sind die Punktzahlen ?"
  520.  REM WINDOW 5,"Request",(300,100)-(600,150),0,1
  521.  REM OPEN "SYS:Fredl" FOR INPUT AS #1
  522.  REM INPUT #1,a$
  523.  REM Fredl:
  524.  REM IF LEN(a$)<3 THEN Fredl2
  525.  REM WINDOW OUTPUT 5
  526.  REM CLS:PRINT :PRINT a$
  527.  REM b$="":WHILE b$="":b$=INKEY$:WEND
  528.  REM IF b$<>CHR$(13) THEN
  529.  REM  Fredl2:
  530.  REM  IF EOF(1)=-1 THEN CLOSE#1:OPEN "SYS:Fredl" FOR INPUT AS #1
  531.  REM  INPUT#1,a$:GOTO Fredl
  532.  REM  END IF 
  533.  REM CLOSE #1
  534.  REM punktfile$(a)=a$
  535.  REM WINDOW CLOSE 5 
  536.  REM END IF
  537. NEXT a 
  538. WINDOW CLOSE 4
  539. IF fo=1 THEN GOTO mn
  540. mnaus:
  541. FOR a=1 TO 4:MENU 1,a,0:NEXT a:GOTO mn
  542. arbeit:
  543. m2=MENU(1)
  544. ON m2 GOTO eingabe,suchen,sortieren
  545. GOTO mn
  546. sortieren:
  547. LOCATE 1,1:PRINT "Wonach sortieren:"
  548. PRINT "Leistungen e. Athleten  > [1]  Leistungen e. Athleten  < [2]"
  549. PRINT "Alle ersten Leistungen  > [3]  Alle ersten Leisungen   < [4]"
  550. PRINT "Alle Bestleistungen     > [5]  Alle Bestleistungen     < [6]"
  551. PRINT "Namen alphabetisch        [7]  Geburtstag                [8]"
  552. PRINT "Treffen Sie Ihre Wahl ... [9] = Menu"
  553. a$=""
  554. WHILE a$<"1" OR a$>"9"
  555.  a$=INKEY$
  556. WEND
  557. mo=VAL(a$)
  558. ON mo GOTO ekg,ekk,abg,abk,aeg,aek,na,ga
  559. CLS:GOTO mn
  560. ekg:
  561. IF dt>1 THEN mo=2
  562. GOSUB ksuch
  563. PRINT "Leistungen werden nach > sortiert."
  564. GOTO s2
  565. ekk:
  566. ksuch:
  567. LINE INPUT "Für welchen Athleten :";su$
  568. IF su$="" THEN CLS:GOTO mn
  569. IF su$="*" THEN za=d:fo=za:GOTO pr
  570. fo=0:za=1
  571. FOR a=1 TO d
  572. IF UCASE$(LEFT$(da$(1,a),LEN(su$)))=UCASE$(su$) THEN fo=a:a=d
  573. NEXT a
  574. IF fo=0 THEN PRINT "Nicht gefunden !!!!":SLEEP:SLEEP:CLS:GOTO mn
  575. pr:
  576. PRINT  da$(1,fo)" gefunden.Gespeicherte Leistungen:"l(fo):IF mo=1 THEN IF su$<>"*" OR za=d THEN RETURN
  577. PRINT "Leistungen werden nach < sortiert.
  578. s2:
  579. IF l(fo)<=1 THEN GOTO zaender
  580. FOR z=1 TO l(fo)
  581. FOR dd=1 TO l(fo)-1
  582. IF mo=2 AND dt=1 AND RIGHT$(STR$(VAL(da$(3,1))),LEN(STR$(VAL(da$(3,1))))-1)=da$(3,1) THEN
  583.  IF VAL(da$(5*(dd+1)+(-3+1)+((dt-1)*((dd+1)-1)),fo))<VAL(da$(5*dd+(-3+1)+((dt-1)*(dd-1)),fo)) THEN GOTO s2ein
  584. END IF
  585. IF mo=1 AND dt=1 AND RIGHT$(STR$(VAL(da$(3,1))),LEN(STR$(VAL(da$(3,1))))-1)=da$(3,1) THEN
  586.  IF VAL(da$(5*(dd+1)+(-3+1)+((dt-1)*((dd+1)-1)),fo))>VAL(da$(5*dd+(-3+1)+((dt-1)*(dd-1)),fo)) THEN GOTO s2ein
  587. END IF
  588. IF dt=1 AND RIGHT$(STR$(VAL(da$(3,1))),LEN(STR$(VAL(da$(3,1))))-1)<>da$(3,1) THEN
  589.  z1$=STR$(VAL(LEFT$(da$(5*dd+(-3+dt)+((dt-1)*(dd-1)),fo),2)))
  590.  z2$=STR$(VAL(LEFT$(da$(5*(dd+1)+(-3+dt)+((dt-1)*((dd+1)-1)),fo),2)))
  591.  z1$=z1$+RIGHT$(da$(5*dd+(-3+dt)+((dt-1)*(dd-1)),fo),4)
  592.  z2$=z2$+RIGHT$(da$(5*(dd+1)+(-3+dt)+((dt-1)*((dd+1)-1)),fo),4)
  593.  IF mo=2 AND VAL(z2$)<VAL(z1$) THEN GOTO s2ein
  594.  IF mo=1 AND VAL(z2$)>VAL(z1$) THEN GOTO s2ein
  595. END IF
  596. IF dt>1 THEN
  597.  IF VAL(da$(5*(dd+1)+(dt-2)+((dt-1)*((dd+1)-1)),fo))>VAL(da$(5*dd+(dt-2)+((dt-1)*(dd-1)),fo)) THEN GOTO s2ein
  598. END IF
  599. GOTO s2aus
  600. s2ein:
  601. FOR a=1 TO dt
  602.  SWAP da$(5*dd+(-3+a)+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+(-3+a)+((dt-1)*((dd+1)-1)),fo)
  603. NEXT a
  604. SWAP da$(5*dd+(dt-2)+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+(dt-2)+((dt-1)*((dd+1)-1)),fo)
  605. SWAP da$(5*dd+(dt-1)+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+(dt-1)+((dt-1)*((dd+1)-1)),fo)
  606. SWAP da$(5*dd+dt+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+dt+((dt-1)*((dd+1)-1)),fo)
  607. SWAP da$(5*dd+dt+1+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+dt+1+((dt-1)*((dd+1)-1)),fo)
  608. s2aus:
  609. NEXT dd:NEXT z:
  610. zaender:
  611. za=za-1:IF za=0 THEN CLS:GOTO mn 
  612. fo=za:GOTO pr
  613. abg:
  614. PRINT "Die ersten Leistungen werden nach > sortiert !!!"
  615. GOTO sort
  616. abk:
  617. PRINT "Die ersten Leistungen werden nach < sortiert !!!"
  618. IF dt>1 THEN mo=3
  619. GOTO sort
  620. aeg:
  621. PRINT "Die ersten Wettkampf-Leistungen werden nach > sortiert !!"
  622. GOTO sort
  623. aek:
  624. PRINT "Die ersten Wettkampf-Leistungen werden nach < sortiert !!"
  625. GOTO sort
  626. ga: 
  627. PRINT  "Geburtstag wird sortiert !"
  628. GOTO sort
  629. na:
  630. PRINT "Namen werden alphabetisch sortiert !!!"
  631. sort:
  632. FOR a=1 TO d
  633. FOR dd=1 TO d-1:ll=0:t1=0:t2=0
  634. IF INSTR(1,da$(3,1),":")>0 THEN ll=1
  635. IF mo=3 AND dt=1 OR mo=4 AND dt=1 THEN so1$=da$(3,dd):so2$=da$(3,dd+1)
  636. IF dt>1 AND mo>4 AND mo<7 THEN mo=mo-2
  637. IF mo=3 AND dt>1 OR mo=4 AND dt>1 THEN so1$=da$(5*1+(dt-2)+((dt-1)*(1-1)),dd):so2$=da$(5*1+(dt-2)+((dt-1)*(1-1)),dd+1)
  638. IF dt>1 OR mo<5 OR mo>6 THEN GOTO sweiter
  639. k1=1:k2=1:ws=0:so1$="":so2$=""
  640. abr:
  641. IF UCASE$(da$(5*k1+(dt-2)+((dt-1)*(k1-1)),dd))<>"W" THEN k1=k1+1:ws=1
  642. IF k1>l(dd) AND mo=5 THEN so1$="0":ws=0
  643. IF k1>l(dd) AND mo=6 THEN so1$="9999999999":ws=0
  644. IF ws=1 THEN ws=0:GOTO abr
  645. IF so1$="" THEN so1$=da$(5*k1+(-3+1)+((dt-1)*(k1-1)),dd)
  646. abr2:
  647. IF UCASE$(da$(5*k2+(dt-2)+((dt-1)*(k2-1)),dd+1))<>"W" THEN k2=k2+1:ws=1
  648. IF k2>l(dd+1) AND mo=5 THEN so2$="0":ws=0
  649. IF k2>l(dd+1) AND mo=6 THEN so2$="9999999999":ws=0
  650. IF ws=1 THEN ws=0:GOTO abr2
  651. IF so2$="" THEN so2$=da$(5*k2+(-3+1)+((dt-1)*(k2-1)),dd+1) 
  652. sweiter:
  653. IF mo=5 AND dt>1 THEN 
  654.  IF VAL(
  655. IF mo=3 AND ll=0 AND dt=1 THEN
  656.  IF VAL(so2$)>VAL(so1$) THEN GOTO sein
  657. END IF
  658. IF mo=4 AND ll=0 AND dt=1 THEN
  659.  IF VAL(so2$)<VAL(so1$) THEN GOTO sein
  660. END IF
  661. IF ll=1 AND dt=1 AND (mo=3 OR mo=4) THEN
  662.  z1$=RIGHT$(STR$(VAL(so1$)),LEN(STR$(VAL(so1$)))-1)
  663.  z2$=RIGHT$(STR$(VAL(so2$)),LEN(STR$(VAL(so2$)))-1)
  664.  z1$=z1$+RIGHT$(so1$,(LEN(so1$)-INSTR(so1$,":"))):z2$=z2$+RIGHT$(so2$,(LEN(so2$)-INSTR(so2$,":")))
  665.  IF mo=3 AND VAL(z2$)>VAL(z1$) THEN GOTO sein
  666.  IF mo=4 AND VAL(z2$)<VAL(z1$) THEN GOTO sein
  667. END IF
  668. IF mo=3 AND dt>1 THEN
  669.  IF VAL(so1$)<VAL(so2$) THEN GOTO sein
  670. END IF
  671. IF mo=7 THEN IF UCASE$(da$(1,dd+1))<UCASE$(da$(1,dd)) THEN GOTO sein
  672. IF mo=8 THEN d1$=RIGHT$(da$(2,dd),4):d1$=d1$+MID$(da$(2,dd),4,2):d1$=d1$+LEFT$(da$(2,dd),2):d2$=RIGHT$(da$(2,dd+1),4)+MID$(da$(2,dd+1),4,2)+LEFT$(da$(2,dd+1),2):IF VAL(d2$)<VAL(d1$) THEN GOTO sein
  673. IF mo=6 AND ll=0 AND dt=1 THEN
  674.  IF VAL(so2$)<VAL(so1$) THEN GOTO sein
  675. END IF
  676. IF mo=5 AND dt=1 AND ll=0 THEN
  677.  IF VAL(so2$)>VAL(so1$) THEN GOTO sein
  678. END IF
  679. IF mo=6 AND dt=1 AND ll=1 THEN
  680.  z1$=RIGHT$(STR$(VAL(LEFT$(so1$,2))),LEN(STR$(VAL(LEFT$(so1$,2))))-1)
  681.  z2$=RIGHT$(STR$(VAL(LEFT$(so2$,2))),LEN(STR$(VAL(LEFT$(so2$,2))))-1)
  682.  REM z1$=z1$+RIGHT$(so1$,4):z2$=z2$+RIGHT$(so2$,4)
  683.  z1$=z1$+RIGHT$(so1$,(LEN(so1$)-INSTR(so1$,":"))):z2$=z2$+RIGHT$(so2$,(LEN(so2$)-INSTR(so2$,":")))
  684.  IF VAL(z2$)<VAL(z1$) THEN GOTO sein
  685. END IF
  686. IF mo=5 AND dt=1 AND ll=1 THEN
  687.  z1$=RIGHT$(STR$(VAL(LEFT$(so1$,2))),LEN(STR$(VAL(LEFT$(so1$,2))))-1)
  688.  z2$=RIGHT$(STR$(VAL(LEFT$(so2$,2))),LEN(STR$(VAL(LEFT$(so2$,2))))-1)
  689.  z1$=z1$+RIGHT$(so1$,(LEN(so1$)-INSTR(so1$,":"))):z2$=z2$+RIGHT$(so2$,(LEN(so2$)-INSTR(so2$,":")))
  690.  IF VAL(z2$)>VAL(z1$) THEN GOTO sein
  691. END IF
  692. IF mo=6 AND dt>1 THEN
  693.  IF VAL(da$(5*1+(dt-2)+((dt-1)*(1-1)),dd+1))>VAL(da$(5*1+(dt-2)+((dt-1)*(1-1)),ddh)) THEN GOTO sein
  694. END IF
  695. GOTO send
  696. sein:
  697.  SWAP da$(1,dd+1),da$(1,dd)
  698.  SWAP da$(2,dd+1),da$(2,dd)
  699.  gr=l(dd):IF l(dd+1)>gr THEN gr=l(dd+1)
  700.  FOR b=1 TO gr
  701.   FOR c=1 TO dt
  702.    SWAP da$(5*b+(-3+c)+((dt-1)*(b-1)),dd),da$(5*b+(-3+c)+((dt-1)*(b-1)),dd+1)
  703.   NEXT c
  704.   SWAP da$(5*b+(dt-2)+((dt-1)*(b-1)),dd),da$(5*b+(dt-2)+((dt-1)*(b-1)),dd+1)
  705.   SWAP da$(5*b+(dt-1)+((dt-1)*(b-1)),dd),da$(5*b+(dt-1)+((dt-1)*(b-1)),dd+1)
  706.   SWAP da$(5*b+dt+((dt-1)*(b-1)),dd),da$(5*b+dt+((dt-1)*(b-1)),dd+1)
  707.   SWAP da$(5*b+dt+1+((dt-1)*(b-1)),dd),da$(5*b+dt+1+((dt-1)*(b-1)),dd+1)
  708.  NEXT b:SWAP l(dd),l(dd+1)
  709. send:
  710. NEXT dd:NEXT a:
  711. CLS:GOTO mn 
  712. suchen:
  713. LOCATE 1,1:PRINT  "Nach welchem Begriff soll ich suchen [Nur Name,Geburtstag,Datum oder Ort]"
  714. LINE INPUT su$
  715. IF su$="" THEN CLS:GOTO mn
  716. CLS
  717. FOR dd=1 TO d
  718. IF UCASE$(LEFT$(da$(1,dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen
  719. IF UCASE$(LEFT$(da$(2,dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen
  720. FOR b=1 TO l(dd)
  721. IF UCASE$(LEFT$(da$(5*l(dd)+(dt-1)+((dt-1)*(l(dd)-1)),dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen:b=l(dd)
  722. IF UCASE$(LEFT$(da$(5*l(dd)+dt+((dt-1)*(l(dd)-1)),dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen:b=l(dd)
  723. NEXT b:NEXT dd:SOUND 1200,18,255,0
  724. IF su=0 THEN PRINT "Begriff nicht gefunden !!":
  725. su=0:SLEEP:SLEEP:CLS:GOTO mn
  726. eingabe:
  727. IF d=0 THEN GOTO hinzu
  728. LOCATE 1,1:PRINT "Was hinzufügen [Space],Stop [F1] oder ansehen [Return] ?"
  729. a$=""
  730. WHILE a$<>" " AND a$<>CHR$(13) AND a$<>CHR$(129) 
  731.  a$=INKEY$
  732. WEND 
  733. CLS
  734. IF a$=CHR$(13) THEN dd=1:GOTO ansehen
  735. IF a$=CHR$(129) THEN CLS:GOTO mn
  736. hinzu:
  737. d=d+1
  738. LOCATE 1,1:LINE INPUT "Name      :";da$(1,d)
  739. IF da$(1,d)="" AND d>1 THEN d=d-1:CLS:GOTO mn
  740. ff=0
  741. OPEN "Geburtstag" FOR INPUT AS #1
  742. gelesen:
  743. INPUT#1,a$
  744. IF INSTR(a$,".")>0 THEN MID$(a$,INSTR(a$,"."),1)=","
  745. INPUT#1,b$
  746. IF da$(1,d)=a$ THEN da$(2,d)=b$:ff=1
  747. IF EOF(1)=0 AND ff=0 THEN gelesen
  748. CLOSE 1
  749. IF ff=0 THEN 
  750.  BEEP:LINE INPUT "Geburtstag:";da$(2,d)
  751.  IF da$(2,d)<>"" THEN
  752.   OPEN "Geburtstag" FOR APPEND AS #1
  753.    a$=da$(1,d)
  754.    IF INSTR(a$,",")>0 THEN MID$(a$,INSTR(a$,","),1)="."
  755.    PRINT#1,a$
  756.    PRINT#1,da$(2,d)
  757.   CLOSE 1
  758.  END IF
  759. ELSE
  760.  ff=0:PRINT "Geburtstag:"da$(2,d)
  761. END IF
  762. dd=d
  763. leist:
  764. IF l(dd)=4*(fr-dt) THEN CLS:GOTO ansehen
  765. l(dd)=l(dd)+1
  766. b=0
  767. FOR a=1 TO dt
  768.  PRINT  l(dd)".Leistung im "di$(a)":";
  769.  LINE INPUT da$(5*l(dd)+(-3+a)+((dt-1)*(l(dd)-1)),dd)
  770.  IF da$(5*l(dd)+(-3+1)+((dt-1)*(l(dd)-1)),dd)="" AND l(dd)>1 THEN l(dd)=l(dd)-1:LINE (0,0)-(620,200),0,bf:GOTO ansehen
  771.  REM IF dt>1 THEN
  772.  REM   OPEN punktfile$(a) FOR INPUT AS #1
  773.  REM  a$="999999999"
  774.  REM  WHILE VAL(da$(5*l(dd)+(-3+a)+((dt-1)*(l(dd)-1)),dd))<VAL(a$)
  775.  REM   IF EOF(1)=-1 THEN 
  776.  REM    a$="00":c=0
  777.  REM   ELSE
  778.  REM    INPUT#1,a$:
  779.  REM    IF LEN(a$)>2 THEN 
  780.  REM     INPUT#1,c$:c=VAL(c$)
  781.  REM    END IF
  782.  REM   END IF
  783.  REM  WEND
  784.  REM CLOSE#1
  785.  REM b=b+c
  786.  REM END IF 
  787. NEXT a
  788. IF dt>1 THEN LINE INPUT "Punkte:" , da$(5*l(dd)+(dt-2)+((dt-1)*(l(dd)-1)),dd)
  789. REM IF dt>1 THEN PRINT  "Punkte:"b:da$(5*l(dd)+(dt-2)+((dt-1)*(l(dd)-1)),dd)=STR$(b)
  790. IF dt=1 THEN LINE INPUT "(T)raining oder (W)ettkampf ?";da$(5*l(dd)+(dt-2)+((dt-1)*(l(dd)-1)),dd)
  791. da$(5*l(dd)+dt-1+((dt-1)*(l(dd)-1)),dd)=ort$
  792. da$(5*l(dd)+dt+((dt-1)*(l(dd)-1)),dd)=ta$
  793. LINE INPUT "Abzeichen:";da$(5*l(dd)+dt+1+((dt-1)*(l(dd)-1)),dd)
  794. PRINT "Noch eine Leistung [Return] oder Ende [Space] ?"
  795. a$=""
  796. WHILE a$><" " AND a$><CHR$(13)
  797.  a$=INKEY$
  798. WEND
  799. IF a$=CHR$(13) THEN LOCATE CSRLIN-1,1:PRINT "                                               ":LOCATE CSRLIN-1,1:GOTO leist
  800. CLS
  801. ansehen:
  802. LOCATE 1,1
  803. PRINT "Name       :"da$(1,dd)
  804. PRINT "Geburtstag :"da$(2,dd)
  805. PRINT "Gespeicherte Leistungen :"l(dd)
  806. PRINT "Name ändern  = F1               Geburtstag ändern = F2"
  807. IF su=0 THEN PRINT "Karte weiter = F6               Karte zurück      = F7"
  808. PRINT "neue Leistung= Return           Stop              = Space"
  809. PRINT "Leistungen ändern = 0 -"CHR$(47+l(dd))"
  810. PRINT "Karte löschen = HELP"
  811. a$=""
  812. tast:
  813. a$=INKEY$:IF a$="" THEN tast
  814. IF a$=CHR$(139) THEN 
  815.  LOCATE 11,1:PRINT "Wirklich löschen [RETURN] oder nicht [SPACE] ?"
  816.  WHILE a$<>" " AND a$<>CHR$(13)
  817.  a$=INKEY$
  818.  WEND
  819.  IF a$=" " THEN CLS:GOTO ansehen
  820.  FOR za=dd TO d
  821.   da$(1,za)=da$(1,za+1)
  822.   da$(2,za)=da$(2,za+1)
  823.   l(za)=l(za+1)
  824.   FOR zb=1 TO l(za)
  825.    FOR zc=1 TO dt
  826.     da$(5*zb+(-3+zc)+((dt-1)*(zb-1)),za)=da$(5*zb+(-3+zc)+((dt-1)*(zb-1)),za+1)
  827.    NEXT zc
  828.    FOR zc=-2 TO 1
  829.     da$(5*zb+(dt+zc)+((dt-1)*(zb-1)),za)=da$(5*zb+(dt+zc)+((dt-1)*(zb-1)),a)
  830.    NEXT zc
  831.   NEXT zb
  832.  NEXT za
  833.  d=d-1
  834.  CLS:IF dd>d THEN dd=d
  835.  GOTO ansehen
  836. END IF
  837. IF a$=" "AND su=0 THEN CLS:GOTO mn
  838. IF a$=" "AND su=1 THEN CLS:RETURN
  839. IF a$=CHR$(13) THEN GOTO leist
  840. IF a$=CHR$(134) AND su=0 THEN CLS:IF dd=d THEN GOTO eingabe :ELSE dd=dd+1:GOTO ansehen
  841. IF a$=CHR$(135) AND su=0 THEN CLS:IF dd=1 THEN dd=d:GOTO ansehen :ELSE dd=dd-1:GOTO ansehen
  842. IF a$=CHR$(129) THEN 
  843.  LINE INPUT "Neuer Name :";a$:CLS:IF a$="" THEN GOTO ansehen
  844.  da$(1,dd)=a$:GOTO ansehen
  845. END IF
  846. IF a$=CHR$(130) THEN
  847.  LINE INPUT "Neuer Geburtstag :";a$:CLS:IF a$="" THEN GOTO ansehen
  848.  da$(2,dd)=a$:
  849.  OPEN "Geburtstag" FOR INPUT AS #1
  850.  OPEN "Birthday" FOR OUTPUT AS #2
  851.   geschrieben:
  852.   INPUT#1,a$
  853.   MID$(a$,INSTR(a$,"."),1)=","
  854.   INPUT#1,b$
  855.   IF a$=da$(1,dd) THEN
  856.    MID$(a$,INSTR(a$,","),1)="."
  857.    PRINT#2,a$
  858.    PRINT#2,da$(2,dd)
  859.   ELSE
  860.    MID$(a$,INSTR(a$,","),1)="."
  861.    PRINT#2,a$
  862.    PRINT#2,b$
  863.   END IF
  864.   IF EOF(1)=0 THEN geschrieben
  865.  CLOSE 2
  866.  CLOSE 1
  867.  KILL "Geburtstag"
  868.  NAME "Birthday" AS "Geburtstag"
  869.  GOTO ansehen
  870. END IF
  871. IF a$<"0" OR a$>CHR$(47+l(dd)) THEN GOTO tast
  872. le=ASC(a$)-47
  873. le2:
  874. PRINT 
  875. FOR a=1 TO dt
  876. PRINT le".Leistung im "di$(a)":"da$(5*le+(-3+a)+((dt-1)*(le-1)),dd)
  877. a$=""
  878. WHILE a$=""
  879.  a$=INKEY$
  880. WEND
  881. IF a$=" "THEN 
  882.  LOCATE CSRLIN-1,16+LEN(di$(a))+LEN(STR$(l(le)))
  883.  LINE INPUT;a$:PRINT 
  884.  IF a$<>"" THEN da$(5*le+(-3+a)+((dt-1)*(le-1)),dd)=a$
  885. END IF
  886. NEXT a
  887. IF dt>1 THEN PRINT "Punkte:";: :ELSE PRINT "(T)raining oder (W)ettkampf : ";
  888. PRINT  da$(5*le+(dt-2)+((dt-1)*(le-1)),dd)
  889. a$=""
  890. WHILE a$=""
  891.  a$=INKEY$
  892. WEND
  893. IF a$=" " THEN
  894.  IF dt>1 THEN LOCATE CSRLIN-1,8::ELSE LOCATE CSRLIN-1,32
  895.  LINE INPUT;a$:PRINT 
  896.  IF a$<>"" THEN da$(5*le+(dt-2)+((dt-1)*(le-1)),dd)=a$
  897. END IF
  898. PRINT "Ort:"da$(5*le+dt-1+((dt-1)*(le-1)),dd)
  899. a$=""
  900. WHILE a$=""
  901.  a$=INKEY$
  902. WEND
  903. IF a$=" "THEN
  904.  LOCATE CSRLIN-1,5
  905.  LINE INPUT;a$:PRINT 
  906.  IF a$<>"" THEN da$(5*le+dt-1+((dt-1)*(le-1)),dd)=a$
  907. END IF
  908. PRINT "Datum:"da$(5*le+dt+((dt-1)*(le-1)),dd)
  909. a$=""
  910. WHILE a$=""
  911.  a$=INKEY$
  912. WEND
  913. IF a$=" "THEN
  914.  LOCATE CSRLIN-1,7
  915.  LINE INPUT;a$:PRINT 
  916.  IF a$<>"" THEN da$(5*le+dt+((dt-1)*(le-1)),dd)=a$
  917. END IF
  918. PRINT "Abzeichen:"da$(5*le+dt+1+((dt-1)*(le-1)),dd)
  919. a$=""
  920. WHILE a$=""
  921.  a$=INKEY$
  922. WEND
  923. IF a$=" " THEN
  924.  LOCATE CSRLIN-1,11
  925.  LINE INPUT;a$:PRINT 
  926.  IF a$<>"" THEN da$(5*le+dt+1+((dt-1)*(le-1)),dd)=a$
  927. END IF
  928. PRINT :PRINT "Weiter : RETURN , Stop : SPACE"
  929. wt:
  930. a$=INKEY$
  931. IF a$<>" " AND a$<>CHR$(13) THEN wt 
  932. IF a$=" " THEN CLS:GOTO ansehen
  933. IF le=l(dd) THEN PRINT "Schluss der Leistungen !!":FOR a=1 TO 500:NEXT a:CLS:GOTO ansehen
  934. le=le+1:GOTO le2
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.